home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS in a Box 7
/
BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso
/
Files
/
Tele
/
Pete Johnson
/
mehit 3.0.b15<source>.cpt
/
mehit.p
< prev
next >
Wrap
Text File
|
1991-07-10
|
38KB
|
1,372 lines
program mehit;
{ Version information }
{ 2.01 runs correctly under MultiFinder with new HelloTabby unit }
{ 2.03 fixes SFPutFile for message text list }
{ 2.04 won't delete last message, to keep high message mark intact }
{ 2.05 moves messages in section 0 to section 255, where they can be deleted }
{ 2.06 is a bug fix for 2.05 }
{ 2.07 can undelete public messages, stuffs messages, adds Log-O-Matic functions }
uses
Globals, Help, HelloTabby, mehitFile, Backup, Centerer, FileAndStuffIt, mehitDialogs;
const
Demo = false; { if true, amnesia on 1st & 16th, otherwise perfect memory }
StrId = 256; { # of STR# resource }
AppleID = 256; { # of Apple menu resource }
FileID = 257; { # of File menu resource }
EditID = 258; { # of Edit menu resource }
GlobalID = 259; { # of Global menu resource }
AlterSecsID = 1001;
SaveChangesID = 1002;
AboutId = 10000; { # of DLOG resource }
var
OptionWindow: GrafPtr; { The main window }
ScrollSect, { Name+Scroll bar for list }
Box, { Spare rect variable }
Databounds: Rect; { list dimensions }
inCell, { cell where new data goes }
CSize: Point; { Size of a list cell }
MessageList: ListHandle; { Handle to 1st list }
TrueFalse, { boolean variable }
done: Boolean; { Are we done? }
CellValue: str255; { What goes in a cell }
TheEvent: eventrecord; { When we get the event }
CommandState: integer; { State of Command key }
AppleMenu, FileMenu, EditMenu, GlobalMenu: MenuHandle;
ControlResult, ItemType, ItemHit, RefNum: integer;
WhichControl: ControlHandle;
TotalLimits, AboutItem, ConfigItem, CharCode, KeyCode, Counter: integer;
Item: handle;
TempString, AlterTitle: STR255;
AlterDialog, HelpDialog, ConstructionDialog: DialogPtr;
thisButton: ControlHandle;
theCell, MouseLoc: Point;
theKeys: keyMap;
OldLevel, NewLevel: longint;
SFwhere: point;
SettingString, LimitString, AgeString, BackUpString, TheLaunch: Str255;
HBuffStr, TBuffStr: Str255;
launchVRefNum: integer;
beginning, WindowGone, NeedConfig: boolean;
DClickBox, CatBox: rect;
{ ------------------------------------------------------ }
procedure Amnesia;
var
Today: DateTimeRec;
AHandle: Handle;
OurResourceFile, ResourceCount: integer;
begin
GetTime(Today);
if (Today.Day = 1) | (Today.Day = 16) then
begin
for ResourceCount := 1 to 255 do
begin
AHandle := GetResource('STR ', 1000 + ResourceCount);
if AHandle^ <> nil then
RmveResource(AHandle);
end;
UpdateResFile(OurResourceFile);
end;
end;
{ ------------------------------------------------------ }
function Launchit (pLnch: pLaunchStruct): OSErr;
inline
$205F, $A9F2, $3E80;
{ ------------------------------------------------------ }
procedure Transfer;
var
pMyLaunch: pLaunchStruct;
myLaunch: LaunchStruct;
MyPB: CInfoPBRec;
begin
with MyPB do
begin
ioNamePtr := @TheLaunch;
ioVRefNum := launchVRefNum;
ioFDirIndex := 0;
ioDirID := 0;
end; { with }
Err := PBGetCatInfo(@MyPB, false);
pMyLaunch := @myLaunch;
with pMyLaunch^ do
begin
pfName := @TheLaunch;
param := 0;
LC[0] := 'L';
LC[1] := 'C';
extBlockLen := 6;
fFlags := myPB.ioFlFndrInfo.fdFlags;
if MultiFinder then {config multifinder}
LaunchFlags := $C0000000 { set BOTH high bits for a sublaunch }
else
LaunchFlags := $00000000; { just launch, then quit }
end; { with pMyLaunch^ }
Err := Launchit(pMyLaunch);
end;
{ ------------------------------------------------------ }
procedure Strip (var TheString: STR255);
{ Strips leading and trailing spaces from string }
var
SpaceCount: integer;
begin
while pos(' ', TheString) = 1 do
TheString := copy(TheString, 2, length(TheString) - 1);
for SpaceCount := length(TheString) downto 1 do
if TheString[SpaceCount] = ' ' then
TheString := copy(TheString, 1, length(TheString) - 1)
else
leave;
end;
{----------------------------------------------------------------- }
procedure Refresh;
var
r: rect;
pad: str255;
lengthCount: integer;
begin
SetPort(OptionWindow);
ForeColor(BlackColor);
r := MessageList^^.rView; { Get the rectangle… }
InsetRect(r, -1, -1); { Stretch it a little bit… }
FrameRect(r); { And draw it. }
ForeColor(RedColor);
TextFont(Monaco);
TextSize(9);
GetDItem(OptionWindow, 1, ItemType, Item, Box);
SetDItem(OptionWindow, 1, ItemType, Item, Box);
GetDItem(OptionWindow, 2, ItemType, Item, Box);
SetDItem(OptionWindow, 2, ItemType, Item, Box);
GetDItem(OptionWindow, 4, ItemType, Item, Box);
SetDItem(OptionWindow, 4, ItemType, Item, Box);
GetDItem(OptionWindow, 11, ItemType, Item, Box);
pad := '';
for lengthCount := 1 to (9 - length(mehitVersion)) do
pad := concat(pad, ' ');
SetIText(Item, concat(pad, mehitVersion));
DrawDialog(OptionWindow);
end;
{ ------------------------------------------------------ }
procedure FillList;
var
Counter, FormatCount: integer;
Listing: STR255;
begin
SetPort(OptionWindow);
ForeColor(BlackColor);
TextFont(Monaco);
TextSize(9);
{ Add items to the list. }
inCell.h := 0; {always in column 0}
for Counter := 1 to SectionCount do
begin
inCell.v := Counter - 1; { rows start at zero, but message sections from 1 }
NumToString(Sections[Counter]^^.Number, Listing);
for FormatCount := 1 to (3 - length(Listing)) do
Listing := concat(' ', Listing);
Listing := concat(Listing, ' ', Sections[Counter]^^.Name);
for FormatCount := 1 to (30 - length(Listing)) do
Listing := concat(Listing, '.');
NumToString(Sections[Counter]^^.Limit, TempString);
for FormatCount := 1 to (5 - length(TempString)) do
TempString := concat(' ', TempString);
Listing := concat(Listing, TempString);
NumToString(Sections[Counter]^^.Age, TempString);
for FormatCount := 1 to (5 - length(TempString)) do
TempString := concat(' ', TempString);
Listing := concat(Listing, TempString, ' ');
if Sections[Counter]^^.Backup = true then
Listing := concat(Listing, 'Y')
else
Listing := concat(Listing, 'N');
LSetCell(Pointer(ord(@Listing) + 1), Length(Listing), inCell, MessageList);
end; {for}
{ Scroll to the first item. }
LAutoScroll(MessageList);
{ Next lines add total sections to dialog }
ForeColor(RedColor);
TextFont(Monaco);
TextSize(9);
GetDItem(OptionWindow, 1, ItemType, Item, Box);
NumToString(SectionCount, TempString);
SetIText(Item, TempString);
{ Next lines add total limits to dialog }
TotalLimits := 0;
for Counter := 1 to SectionCount do
if Sections[Counter]^^.Limit > 0 then
TotalLimits := TotalLimits + Sections[Counter]^^.Limit;
GetDItem(OptionWindow, 2, ItemType, Item, Box);
NumToString(TotalLimits, TempString);
SetIText(Item, TempString);
GetDItem(OptionWindow, 4, ItemType, Item, Box);
NumToString(TotalLimits div SectionCount, TempString);
SetIText(Item, TempString);
ForeColor(BlackColor);
end;
{----------------------------------------------------------------- }
procedure SetUpLists;
begin
{ Set the list up using dimensions of User Item 3 in DLOG resource }
GetDItem(OptionWindow, 3, ItemType, Item, Box);
{ One column x SectionCount means… }
SetRect(DataBounds, 0, 0, 1, SectionCount);
{ One cell is 14 pixels high by whatever wide… }
cSize.v := 14;
cSize.h := Box.right - Box.left;
{ Set up the 1st list. Start drawing right away, and }
{ put in a vertical scroll bar. }
MessageList := LNew(Box, dataBounds, cSize, 0, OptionWindow, true, false, false, true);
Refresh;
FillList; { fill list with message sections & settings }
{ You can only choose one item at a time. }
MessageList^^.SelFlags := LOnlyOne;
{ This sets up the rectangles for a MouseDown event. It is the }
{ view area of a list, plus a little extra for a scroll bar. }
ScrollSect := MessageList^^.rview;
ScrollSect.right := ScrollSect.right + 16;
end;
{----------------------------------------------------------------- }
procedure FillDialogItems (Str1: STR255; var OldLevel: longint);
var
FormatCount: integer;
begin
getDItem(AlterDialog, 3, itemType, item, Box);
TempString := copy(Str1, 31, 5);
Strip(TempString);
StringToNum(TempString, OldLevel);
SetIText(Handle(item), TempString);
getDItem(AlterDialog, 4, itemType, item, Box);
TempString := copy(Str1, 36, 5);
Strip(TempString);
SetIText(Handle(item), TempString);
getDItem(AlterDialog, 5, itemType, item, Box);
thisButton := ControlHandle(item);
if Str1[44] = 'Y' then
SetCtlValue(thisButton, 1)
else
SetCtlValue(thisButton, 0);
getDItem(AlterDialog, 13, itemType, item, Box);
AlterTitle := copy(Str1, 6, 25);
Strip(AlterTitle);
for FormatCount := length(AlterTitle) downto 1 do
if AlterTitle[FormatCount] = '.' then
AlterTitle := copy(AlterTitle, 1, length(AlterTitle) - 1)
else
leave;
if length(AlterTitle) < 25 then
for FormatCount := 1 to (25 - length(AlterTitle)) do
AlterTitle := concat(' ', AlterTitle);
SetIText(Handle(item), AlterTitle);
SelIText(AlterDialog, 3, 0, 32767);
end;
{----------------------------------------------------------------- }
procedure UpdateList (TheString: STR255);
var
HowLong: integer;
begin
HowLong := 255;
LSetSelect(true, TheCell, MessageList); {turn it on}
LAutoScroll(MessageList);
LGetCell(Pointer(Ord(@TheString) + 1), HowLong, theCell, MessageList);
TheString[0] := Chr(length(TheString));
FillDialogItems(TheString, OldLevel);
end;
{----------------------------------------------------------------- }
procedure ChangeListEntry;
var
Checker: longint;
StrLength, ListingCount, StringCount: integer;
begin
getDItem(AlterDialog, 3, itemType, item, Box);
GetIText(Handle(item), LimitString);
StringToNum(LimitString, Checker);
if Checker > 9999 then
Checker := 0;
NumToString(Checker, LimitString);
while length(LimitString) < 5 do
LimitString := concat(' ', LimitString);
getDItem(AlterDialog, 4, itemType, item, Box);
GetIText(Handle(item), AgeString);
StringToNum(AgeString, Checker);
if Checker > 9999 then
Checker := 0;
NumToString(Checker, AgeString);
while length(AgeString) < 5 do
AgeString := concat(' ', AgeString);
getDItem(AlterDialog, 5, itemType, item, Box);
if GetCtlValue(ControlHandle(item)) = 1 then
BackUpString := 'Y'
else
BackUpString := 'N';
StrLength := 255;
LGetCell(@TempString, StrLength, theCell, MessageList);
SettingString[0] := Chr(StrLength);
for StringCount := 1 to StrLength do
SettingString[StringCount] := TempString[StringCount - 1];
for ListingCount := 1 to 5 do
SettingString[30 + ListingCount] := LimitString[ListingCount];
for ListingCount := 1 to 5 do
SettingString[35 + ListingCount] := AgeString[ListingCount];
SettingString[44] := BackUpString;
LSetCell(Pointer(ord(@SettingString) + 1), Length(SettingString), theCell, MessageList);
end;
{----------------------------------------------------------------- }
procedure ButtonFlicker (TheButton: integer);
var
TempLongInt: longint;
begin
getDItem(AlterDialog, TheButton, itemType, item, Box);
HiLiteControl(ControlHandle(item), 1);
Delay(5, TempLongInt);
HiLiteControl(ControlHandle(item), 0);
end;
{----------------------------------------------------------------- }
function CommandFilter (theDialog: DialogPtr; var theEvent: EventRecord; var ItemHit: integer): boolean;
var
keyPressed: integer;
begin
CommandFilter := false;
if BitAnd(TheEvent.what, keyDown) = keyDown then
begin
if BitAnd(theEvent.modifiers, cmdKey) = cmdKey then
begin
keyPressed := BROTR(BitAnd(theEvent.Message, keyCodeMask), 8);
case keyPressed of
1: { Save }
begin
ItemHit := 1;
ButtonFlicker(1);
end;
8: { Cancel }
begin
ItemHit := 2;
ButtonFlicker(2);
end;
11: { Backup }
begin
ItemHit := 5;
ButtonFlicker(5);
end;
3:
begin
ItemHit := 6; { First }
ButtonFlicker(6);
end;
37:
begin
ItemHit := 7; { Last }
ButtonFlicker(7);
end;
35:
begin
ItemHit := 8; { Previous }
ButtonFlicker(8);
end;
45:
begin
ItemHit := 9; { Next }
ButtonFlicker(9);
end;
4:
begin
ItemHit := 10; { Help }
ButtonFlicker(10);
end;
otherwise
;
end; { Case statement }
CommandFilter := true;
end { if Command key down }
else
begin
keyPressed := BROTR(BitAnd(theEvent.Message, keyCodeMask), 8);
case keyPressed of
52, 76, 36:
begin
ItemHit := 1; { Enter, extended Enter, Return }
CommandFilter := true;
ButtonFlicker(1);
end;
otherwise
;
end; { Case statement }
end;
end; { if key down }
end;
{----------------------------------------------------------------- }
procedure SelectionMade;
var
StrLength, code, Counter, AlterCount: Integer;
thisCell, nextCell, AlterDone: Boolean;
where: point;
port: WindowPtr;
TempLongint: longint;
theRgn: RgnHandle;
begin
InitCursor;
theCell.h := 0;
theCell.v := 0;
for nextCell := false to true do
begin
thisCell := LGetSelect(nextCell, theCell, MessageList);
if thisCell then
begin
StrLength := 255;
LGetCell(Pointer(Ord(@SettingString) + 1), StrLength, theCell, MessageList);
SettingString[0] := Chr(StrLength);
AlterDone := false;
AlterDialog := GetNewDialog(AlterSecsID, nil, Pointer(-1));
SetPort(AlterDialog);
FrameDItem(AlterDialog, Ok);
FillDialogItems(SettingString, OldLevel);
if StillDown then
repeat
until not Button;
FlushEvents(EveryEvent, 0);
repeat
ModalDialog(@CommandFilter, ItemHit);
case ItemHit of
1: { Save button hit }
begin
ChangeListEntry;
Changed := true;
AlterDone := true;
end;
2: { Cancel button hit }
AlterDone := true;
5: { B/U toggle hit }
begin
getDItem(AlterDialog, 5, itemType, item, Box);
if GetCtlValue(ControlHandle(item)) = 0 then
SetCtlValue(ControlHandle(item), 1)
else
SetCtlValue(ControlHandle(item), 0);
end;
6: { First button hit }
begin
ChangeListEntry;
Changed := true;
LSetSelect(false, TheCell, MessageList); {turn it off}
theCell.v := 0;
UpdateList(SettingString);
end;
7: { Last Button hit }
begin
ChangeListEntry;
Changed := true;
LSetSelect(false, TheCell, MessageList); {turn it off}
theCell.v := SectionCount - 1;
UpdateList(SettingString);
end;
8: { Previous button hit }
begin
ChangeListEntry;
Changed := true;
LSetSelect(false, TheCell, MessageList); {turn it off}
if theCell.v = 0 then
theCell.v := SectionCount - 1
else
theCell.v := pred(theCell.v);
UpdateList(SettingString);
end;
9: { Next button hit }
begin
ChangeListEntry;
Changed := true;
LSetSelect(false, TheCell, MessageList); {turn it off}
if theCell.v < SectionCount - 1 then
theCell.v := succ(theCell.v)
else
theCell.v := 0;
UpdateList(SettingString);
end;
10: { Help button hit }
begin
GetHelp(257);
BeginUpdate(OptionWindow);
Refresh;
theRgn := WindowPtr(OptionWindow)^.VisRgn;
LUpdate(theRgn, MessageList);
EndUpdate(OptionWindow);
SetPort(AlterDialog);
FrameDItem(AlterDialog, Ok);
end;
otherwise
;
end; { case ItemHit }
until AlterDone;
DisposDialog(AlterDialog);
theCell.h := 0;
theCell.v := 0;
Leave; { exit the for loop since we're done }
end; { if thisCell }
end; { for nextCell := false to true }
{ update counter }
TotalLimits := 0;
theCell.h := 0;
for Counter := 1 to SectionCount do
begin
theCell.v := Counter - 1;
LGetCell(@SettingString, StrLength, theCell, MessageList);
SettingString[0] := chr(StrLength);
TempString := copy(SettingString, 30, 5);
while TempString[1] = ' ' do
TempString := copy(TempString, 2, length(TempString) - 1);
StringToNum(TempString, TempLongint);
if TempLongint > 0 then
TotalLimits := TotalLimits + TempLongint;
end;
SetPort(OptionWindow);
ForeColor(RedColor);
GetDItem(OptionWindow, 1, ItemType, Item, Box);
NumToString(SectionCount, TempString);
SetIText(Item, TempString);
GetDItem(OptionWindow, 2, ItemType, Item, Box);
NumToString(TotalLimits, TempString);
SetIText(Item, TempString);
GetDItem(OptionWindow, 4, ItemType, Item, Box);
NumToString(TotalLimits div SectionCount, TempString);
SetIText(Item, TempString);
ForeColor(BlackColor);
end;
{----------------------------------------------------------------- }
procedure ShowBigHelp;
var
HelpItem: integer;
begin
InitCursor;
HelpDialog := GetNewDialog(1010, nil, Pointer(-1));
SetPort(HelpDialog);
FrameDItem(HelpDialog, Ok);
if StillDown then
repeat
until not Button;
repeat
ModalDialog(nil, HelpItem);
until (HelpItem = 1);
DisposDialog(HelpDialog);
end;
{----------------------------------------------------------------- }
procedure FillNumbers (GlobalString: STR255; Offset: integer);
{ Fills section data in list with numeric data for Limit and Age field. }
{ Offset determines where data is written—29 for Limit, 34 for Age. }
var
Counter, InsertCount, TheLength: integer;
ListLine: STR255;
GlobalNumber: longint;
begin
StringToNum(GlobalString, GlobalNumber); { Make sure this is a }
if GlobalNumber > 9999 then { valid number. }
GlobalNumber := 0;
if Offset = 29 then { Adjust cumulative Limit figure }
begin
if GlobalNumber > 0 then
TotalLimits := GlobalNumber * SectionCount
else
TotalLimits := 0;
SetPort(OptionWindow);
ForeColor(RedColor);
GetDItem(OptionWindow, 1, ItemType, Item, Box);
NumToString(SectionCount, TempString);
SetIText(Item, TempString);
GetDItem(OptionWindow, 2, ItemType, Item, Box);
NumToString(TotalLimits, TempString);
SetIText(Item, TempString);
GetDItem(OptionWindow, 4, ItemType, Item, Box);
NumToString(TotalLimits div SectionCount, TempString);
SetIText(Item, TempString);
end;
NumToString(GlobalNumber, GlobalString);
while length(GlobalString) < 5 do { Pad to length 5 }
GlobalString := concat(' ', GlobalString);
inCell.h := 0;
for Counter := 1 to SectionCount do
begin
inCell.v := Counter - 1;
TheLength := 255;
LGetCell(@ListLine, TheLength, inCell, MessageList);
for InsertCount := 1 to 5 do
ListLine[Offset + InsertCount] := GlobalString[InsertCount];
LSetCell(@ListLine, TheLength, inCell, MessageList);
end;
end;
{----------------------------------------------------------------- }
procedure FillBackup (GlobalString: STR255);
var
Counter, TheLength: integer;
ListLine: STR255;
begin
GlobalString := copy(GlobalString, 1, 1);
uprString(GlobalString, false);
inCell.h := 0;
for Counter := 1 to SectionCount do
begin
inCell.v := Counter - 1;
TheLength := 255;
LGetCell(@ListLine, TheLength, inCell, MessageList);
if GlobalString = 'Y' then
begin
ListLine[43] := 'Y';
LSetCell(@ListLine, TheLength, inCell, MessageList);
end
else
begin
ListLine[43] := 'N';
LSetCell(@ListLine, TheLength, inCell, MessageList);
end;
end;
end;
{----------------------------------------------------------------- }
procedure RotateDog (var DogCount: integer);
begin
SetCursor(GetCursor(1000 + DogCount)^^);
if DogCount < 8 then
DogCount := succ(DogCount)
else
DogCount := 1;
end;
{----------------------------------------------------------------- }
function FindPrefsFile: integer;
var
theWorld: SysEnvRec;
sysVRef, prefsRef: integer;
SystemPath: str255;
fndrInfo: FInfo;
begin
newExternalFile := false;
prefsRef := 0;
err := SysEnvirons(1, theWorld);
if err = noErr then
begin
sysVRef := theWorld.sysVRefNum; {it's in the System Folder}
MakePath('System', sysVRef, SystemPath);
prefsRef := OpenResFile(concat(SystemPath, 'Preferences:mehit prefs'));
if (PrefsRef = -1) then
begin
CreateResFile(concat(SystemPath, 'Preferences:mehit prefs'));
if ResError = noErr then
begin
newExternalFile := true;
err := GetFInfo(concat(SystemPath, 'Preferences:mehit prefs'), sysVRef, fndrInfo);
with fndrInfo do
begin
fdType := 'pref';
fdCreator := 'mhtb';
end;
err := SetFInfo(concat(SystemPath, 'Preferences:mehit prefs'), sysVRef, fndrInfo);
prefsRef := OpenResFile(concat(SystemPath, 'Preferences:mehit prefs'));
end
else
begin
prefsRef := OpenResFile(concat(SystemPath, 'mehit prefs'));
if (PrefsRef = -1) then
begin
newExternalFile := true;
CreateResFile(concat(SystemPath, 'mehit prefs'));
end;
err := GetFInfo(concat(SystemPath, 'mehit prefs'), sysVRef, fndrInfo);
with fndrInfo do
begin
fdType := 'pref';
fdCreator := 'mhtb';
end;
err := SetFInfo(concat(SystemPath, 'mehit prefs'), sysVRef, fndrInfo);
prefsRef := OpenResFile(concat(SystemPath, 'mehit prefs'));
end;
end;
end;
FindPrefsFile := prefsRef
end;
{----------------------------------------------------------------- }
procedure UpdateResources;
var
ResourceCount, TheLength, BuildCount, STR_Number, DogCount: integer;
AHandle: Handle;
Description, ListLine, STR_NAME: STR255;
begin
SetCursor(GetCursor(1001)^^);
DogCount := 2;
UseResFile(externalResFile);
for ResourceCount := 1 to 255 do
begin
AHandle := GetResource('STR ', 1000 + ResourceCount);
if AHandle^ <> nil then
RmveResource(AHandle);
if ResourceCount mod 68 = 0 then
RotateDog(DogCount);
end;
UpdateResFile(externalResFile);
inCell.h := 0;
for ResourceCount := 1 to SectionCount do
begin
Description := '';
TempString := '';
inCell.v := ResourceCount - 1;
TheLength := 255;
LGetCell(@ListLine, TheLength, inCell, MessageList);
ListLine[0] := chr(TheLength);
for BuildCount := 30 to 34 do
Description := concat(Description, ListLine[BuildCount]);
Strip(Description);
Description := concat(Description, '&');
for BuildCount := 35 to 39 do
TempString := concat(TempString, ListLine[BuildCount]);
Strip(TempString);
Description := concat(Description, TempString, '&&', ListLine[43]);
NumToString(Sections[ResourceCount]^^.Number, STR_Name);
STR_Name := concat('Section ', STR_Name);
STR_Number := 1000 + Sections[ResourceCount]^^.Number;
AddResource(Handle(NewString(Description)), 'STR ', STR_Number, STR_Name);
UpdateResFile(externalResFile);
RotateDog(DogCount)
end;
SetCursor(GetCursor(1000)^^);
end;
{----------------------------------------------------------------- }
procedure SavingResources;
var
theDialog: DialogPtr;
begin
theDialog := GetNewDialog(1006, nil, Pointer(-1));
SetPort(theDialog);
DrawDialog(theDialog);
UpdateResources;
DisposDialog(theDialog);
Refresh;
end;
{----------------------------------------------------------------- }
procedure AskSaveChanges;
var
theRgn: RgnHandle;
theDialog: DialogPtr;
begin
theDialog := GetNewDialog(SaveChangesID, nil, Pointer(-1));
SetPort(theDialog);
FrameDItem(theDialog, Ok);
ModalDialog(nil, AboutItem);
repeat
until (AboutItem = 1) | (AboutItem = 2);
DisposDialog(theDialog);
if AboutItem = 1 then
SavingResources;
Changed := false;
Refresh;
theRgn := WindowPtr(OptionWindow)^.VisRgn;
LUpdate(theRgn, MessageList);
end;
{----------------------------------------------------------------- }
procedure HandleMenu (theMenu, theItem: integer);
var
theDialog: DialogPtr;
theName, GlobalString, ListLine: Str255;
Counter, ListRef, TheLength: integer;
ListXfer, AFilePos: longint;
where: point;
ListCell: Cell;
whatToFind: SFTypeList;
fileReply: SFReply;
begin
case theMenu of
AppleID: { Apple Menu }
case theItem of
1:
begin
theDialog := GetNewDialog(AboutID, nil, Pointer(-1));
setport(theDialog);
CenterDLOG(theDialog);
ForeColor(RedColor);
TextFont(Monaco);
TextSize(9);
GetDItem(theDialog, 3, ItemType, Item, Box);
SetIText(Item, mehitVersion);
ShowWindow(theDialog);
SetCursor(GetCursor(1000)^^);
ModalDialog(nil, AboutItem);
repeat
until AboutItem = 1;
DisposDialog(theDialog);
Refresh;
InitCursor;
end; {case 1}
otherwise
begin
GetItem(AppleMenu, theItem, TheName);
theItem := OpenDeskAcc(TheName);
end; {otherwise}
end; { case 256 }
FileID: { File Menu }
case theItem of
1: { Configure }
begin
InitCursor;
HideWindow(OptionWindow);
ConfigureDialog;
ShowWindow(OptionWindow);
Refresh;
end;
2: { Run }
begin
if (Changed = true) then
AskSaveChanges;
DisposDialog(OptionWindow);
WindowGone := true;
ReadSTRs;
BackupMessages;
Done := true;
end;
4: { Save }
begin
SavingResources;
Changed := false;
end;
5: { Revert }
begin
FillList;
Changed := false;
end;
7: { Save List as Text }
begin
where.h := 60;
where.v := 80;
SFPPutFile(where, 'save listing as…', 'msg section list', nil, fileReply, 3998, nil);
if fileReply.good then
begin
TimeAt;
Err := FSDelete(fileReply.fname, fileReply.vRefNum);
Err := Create(fileReply.fname, fileReply.vRefNum, DefaultsPtr^.TextType, 'TEXT');
Err := FSOpen(fileReply.fname, fileReply.vRefNum, ListRef);
Err := WrLn(ListRef, concat(' bbs message sections ', DateString, ENDLINE));
Err := WrLn(ListRef, 'no. title limit age b/u');
Err := WrLn(ListRef, '---------------------------------------------');
ListCell.h := 0;
for Counter := 1 to SectionCount do
begin
ListCell.v := Counter - 1;
TheLength := 255;
LGetCell(Pointer(ord(@ListLine) + 1), TheLength, ListCell, MessageList);
ListLine[0] := chr(TheLength);
Err := WrLn(ListRef, ListLine);
end; { for Counter := 1 to SectionCount }
Err := FSClose(ListRef);
end; { if fileReply.good }
end;
9: { Transfer }
begin
if Changed = true then
AskSaveChanges;
SFwhere.h := 60;
SFwhere.v := 80;
whatToFind[0] := 'APPL';
ParamText('select application to launch', '', '', '');
SFPGetFile(SFwhere, '', nil, 1, whatToFind, nil, fileReply, 4000, nil);
if fileReply.good then
begin
for Counter := 1 to SectionCount do
if Handle(Sections[Counter])^ <> nil then
begin
HUnlock(Handle(Sections[Counter]));
DisposHandle(Handle(Sections[Counter]));
end;
if DefaultsPtr <> nil then
DisposPtr(POINTER(DefaultsPtr));
if not WindowGone then
DisposDialog(OptionWindow);
TheLaunch := fileReply.fName;
launchVRefNum := fileReply.vRefNum;
Err := SetVol(nil, launchVRefNum);
Transfer;
end;
end;
10: { Quit }
begin
if Changed = true then
AskSaveChanges;
if DefaultsPtr <> nil then
DefaultsPtr^.DNextLaunch := '';
Done := true;
end;
otherwise
;
end; { case 257 }
EditID: { Edit Menu }
TrueFalse := SystemEdit(theItem - 1); { Feeds DAs correctly }
GlobalID: { Global Menu }
case theItem of
1: { Limit }
begin
ParamText('limit', '', '', '');
GlobalDialog(GlobalString);
if GlobalString <> '' then
FillNumbers(GlobalString, 29);
Refresh;
end;
2: { Age }
begin
ParamText('age', '', '', '');
GlobalDialog(GlobalString);
if GlobalString <> '' then
FillNumbers(GlobalString, 34);
end;
3: { Backup }
begin
ParamText('backup status', '', '', '');
GlobalDialog(GlobalString);
if GlobalString <> '' then
FillBackup(GlobalString);
end;
5: { Help }
begin
GetHelp(256);
Refresh;
end;
end; { case theItem }
end; { case theMenu }
HiliteMenu(0);
end;
{----------------------------------------------------------------- }
procedure HandleEvent (TheEvent: EventRecord);
var
where: point;
code, Counter, TheLength, BuildCount, Result: integer;
tempport: GrafPtr;
port: WindowPtr;
theInfo: longint;
theItem, theMenu, ResourceCount: integer;
theDialog: DialogPtr;
theBool, Bool2: Boolean;
theRgn: RgnHandle;
GlobalString: STR255;
TempBox: rect;
AKeyMap: KeyMap;
begin
case TheEvent.what of
MouseDown:
begin
where := TheEvent.where;
code := FindWindow(where, port);
case Code of
inMenuBar:
begin
theInfo := MenuSelect(where);
theMenu := HiWord(theInfo);
theItem := LoWord(theInfo);
HandleMenu(theMenu, theItem);
end; {case MenuBar}
inContent:
begin
if Port <> FrontWindow then
SelectWindow(Port)
else
begin
theBool := False;
GlobalToLocal(where);
if PtInRect(where, ScrollSect) then
if LClick(where, TheEvent.Modifiers, MessageList) then
SelectionMade;
if PtInRect(where, DClickBox) then
begin
GetDItem(OptionWindow, 7, ItemType, Item, DClickBox);
EraseRect(DClickBox);
TextFont(0);
TextSize(12);
ForeColor(RedColor);
TempBox := DClickBox;
TempBox.top := TempBox.top + 5;
TempBox.bottom := TempBox.bottom + 5;
TempString := 'not here! try a bit lower…';
TextBox(Pointer(ord(@TempString) + 1), length(TempString), TempBox, teJustCenter);
TextFont(Monaco);
TextSize(9);
repeat
until not Button;
SetDItem(OptionWindow, 7, ItemType, Item, DClickBox);
DrawDialog(OptionWindow);
end
else if PtInRect(where, CatBox) then
if BitAnd(theEvent.modifiers, optionKey) = optionKey then
begin
GetDItem(OptionWindow, 10, ItemType, Item, CatBox);
EraseRect(CatBox);
TextFont(Geneva);
TextSize(9);
ForeColor(BlueColor);
TempBox := CatBox;
TempBox.top := TempBox.top + 30;
TempBox.bottom := TempBox.bottom + 30;
TempBox.left := TempBox.left - 5;
TempBox.right := TempBox.right - 5;
TempString := concat('the honey bee is sad and cross', ENDLINE, 'and wicked as a weasel', ENDLINE);
TempString := concat(TempString, 'and when she perches on you boss', ENDLINE, 'she leaves a little measle', ENDLINE);
TextBox(Pointer(ord(@TempString) + 1), length(TempString), TempBox, teJustCenter);
TextFont(Monaco);
TextSize(9);
ForeColor(RedColor);
repeat
until not Button;
SetDItem(OptionWindow, 10, ItemType, Item, CatBox);
DrawDialog(OptionWindow);
end;
ControlResult := FindControl(where, OptionWindow, WhichControl);
if ControlResult = inButton then
ControlResult := TrackControl(WhichControl, where, nil);
if ControlResult <> 0 then
if IsDialogEvent(TheEvent) then
if DialogSelect(TheEvent, theDialog, theItem) then
end;
end; {Case inContent}
inGoAway:
if TrackGoAway(port, where) then
begin
if Changed = true then
AskSaveChanges;
if DefaultsPtr <> nil then
DefaultsPtr^.DNextLaunch := '';
Done := true;
end;
inDrag:
DragWindow(port, where, ScreenBits.bounds);
inSysWindow:
SystemClick(theEvent, port);
end; {Case Code}
end; {Case Mousedown}
UpdateEvt:
begin
BeginUpdate(OptionWindow);
Refresh;
theRgn := WindowPtr(OptionWindow)^.VisRgn;
LUpdate(theRgn, MessageList);
EndUpdate(OptionWindow);
end; {Case UpdateEvt}
keyDown:
begin
CharCode := BitAnd(TheEvent.message, CharCodeMask);
KeyCode := BROTR(BitAnd(TheEvent.message, KeyCodeMask), 8); { Bit rotate to right }
if BitAnd(TheEvent.modifiers, cmdKey) = cmdKey then { Command key down }
begin
theInfo := MenuKey(chr(CharCode));
theMenu := HiWord(theInfo);
theItem := LoWord(theInfo);
HandleMenu(theMenu, theItem);
end; { if BitAnd(TheEvent.modifiers, cmdKey) = cmdKey }
end; { Case keyDown }
end; {Case theEvent of… }
end; {HandleEvent}
{----------------------------------------------------------------- }
var
tempRef: integer;
begin
MaxApplZone;
SetCursor(GetCursor(1000)^^);
Err := HGetVol(@gVolName, vRefNum, dirID); { Get volume ref # & dirID for default volume }
gDefaultpath := PathNameFromDirID(dirID, vRefNum); { Get full pathname }
DefaultVol := vRefNum;
internalResFile := CurResFile;
externalResFile := findPrefsFile;
ReadConfig; {sets MultiFinder value}
if MultiFinder then
IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
ReadMESSAGES;
if MultiFinder then
IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
if Demo then
Amnesia;
ReadSTRs;
NeedConfig := false;
StuffItExists := false;
with DefaultsPtr^ do
begin
Err := FSOpen(DNextLaunch, vRefNum, RefNum);
if Err = NoErr then
Err := FSClose(RefNum)
else
NeedConfig := true;
TempString := concat(DBackupPath, 'junk');
Err := Create(TempString, vRefNum, 'QED1', 'TEXT');
if Err = NoErr then
Err := FSDelete(TempString, vRefNum)
else
NeedConfig := true;
TempString := concat(DefaultsPtr^.DTextPath, 'junk');
Err := Create(TempString, vRefNum, 'QED1', 'TEXT');
if Err = NoErr then
Err := FSDelete(TempString, vRefNum)
else
NeedConfig := true;
if newExternalFile then
NeedConfig := true;
end;
mehitVersion := ReadVersion;
if Demo then
mehitVersion := concat(mehitVersion, ' demo');
FlushEvents(EveryEvent, 0);
if (not Button) & (not NeedConfig) then
BackupMessages
else
begin
OptionWindow := GetNewDialog(1000, nil, Pointer(-1));
SetPort(OptionWindow);
GetDItem(OptionWindow, 7, ItemType, Item, DClickBox);
GetDItem(OptionWindow, 10, ItemType, Item, CatBox);
AppleMenu := GetMenu(AppleId);
AddResMenu(AppleMenu, 'DRVR'); { for those pesky DA's }
InsertMenu(AppleMenu, 0);
FileMenu := GetMenu(FileId);
InsertMenu(FileMenu, 0);
EditMenu := GetMenu(EditId);
InsertMenu(EditMenu, 0);
GlobalMenu := GetMenu(GlobalId);
InsertMenu(GlobalMenu, 0);
DrawMenuBar;
SetUpLists;
done := False; { as we just started }
if not newExternalFile then
Changed := false { nothing changed yet }
else
Changed := true; {no resource file found, so request a Save}
beginning := true;
WindowGone := false;
repeat
if NeedConfig then
begin
ConfigureDialog;
Refresh;
NeedConfig := false
end;
if MultiFinder then
begin
if WaitNextEvent(EveryEvent, TheEvent, sleep, nil) then
HandleEvent(TheEvent)
end
else if GetNextEvent(EveryEvent, TheEvent) then
HandleEvent(TheEvent);
if beginning then
beginning := false;
if OptionWindow = FrontWindow then
begin
GetMouse(MouseLoc);
if PtInRect(MouseLoc, ScrollSect) | not (PtInRect(MouseLoc, OptionWindow^.portrect)) then
InitCursor
else
SetCursor(GetCursor(1000)^^);
end;
until done = true;
if not WindowGone then
DisposDialog(OptionWindow);
end; {else (not Button) & (not NeedConfig)}
for Counter := 1 to SectionCount do
if Handle(Sections[Counter])^ <> nil then
begin
HUnlock(Handle(Sections[Counter]));
DisposHandle(Handle(Sections[Counter]));
end;
if DefaultsPtr <> nil then
begin
NextLaunch := DefaultsPtr^.DNextLaunch;
DisposPtr(POINTER(DefaultsPtr));
end;
closeResFile(externalResFile);
myCloseWD;
if NextLaunch <> '' then
LaunchNextAppl
end.